VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsGetDeclineReasons"
Attribute VB_GlobalNameSpace = True
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

Public Function GetDeclineReasons(ByRef strFailReason As String, ByRef nNumResRecords As String, Optional ByVal strServerName As String) As Boolean

Dim adoConn As ADODB.Connection
Dim objStrConn As Object
Dim strConnString As String
Dim RSReqData As ADODB.Recordset
Dim RSDeclineReason As ADODB.Recordset
Dim RSDirResData As ADODB.Recordset
Dim adoComm As ADODB.Command
Dim strDeclineXml As String
Dim strDeclineReason As String
Dim iCounter As Integer

ServerName = strServerName

On Error GoTo PROC_ERROR

strServerName = "DEV"

Set adoConn = New ADODB.Connection
With adoConn
    .CursorLocation = adUseClient
    .ConnectionString = GetConnectionString() 'Johann (20090625): Centralised code for connection string added
    .Open
End With

Set adoComm = New ADODB.Command
    With adoComm
        .CommandType = adCmdText
        Set .ActiveConnection = adoConn
    End With


'-------------------------------------------------------------------------------------------------------
'Get response data
'adoComm.CommandText = "Select * from dir_request where req_seq_num in (select req_seq_num from dir_interface_index where sars_response_yn = 'N')"
adoComm.CommandText = "Select * from dir_response where (REQUEST_STATUS = '01' or REQUEST_STATUS = '02') and req_seq_num in (select req_seq_num from dir_interface_index where sars_response_yn = 'N')"

Set RSDirResData = adoComm.Execute
nNumResRecords = RSDirResData.RecordCount

    
'Validate recordset exists
Dim dllRecordsetExist As clsIsRecordsetEmpty
Set dllRecordsetExist = New clsIsRecordsetEmpty
Dim blResponseRSEmpty As Boolean
blResponseRSEmpty = dllRecordsetExist.IsEmpty(RSDirResData)

If blResponseRSEmpty = True Then
        GetDeclineReasons = False
        strFailReason = "There were no declined responses to send to MQ"
        nNumDeclRecords = 0
        Exit Function
Else
    Do While Not RSDirResData.EOF
    
    Form1.Show
    
    nReqSeqNum = RSDirResData.Fields("req_seq_num").Value
    
        'Get Response Data
        '.CommandText = "Select * from dir_response where req_seq_num = " & nReqSeqNum & " and (REQUEST_STATUS = '01' or REQUEST_STATUS = '02')"
        adoComm.CommandText = "Select * from dir_request where req_seq_num = " & nReqSeqNum
            
        Set RSReqData = adoComm.Execute
    
        'Validate recordset exists
        Dim blRequestRSEmpty As Boolean
        blRequestRSEmpty = dllRecordsetExist.IsEmpty(RSReqData)
    
        '-------------------------------------------------------------------------------------------------------
        'Get Decline Reason/s
        adoComm.CommandText = "Select * from dir_decline_reasons where req_seq_num  = " & nReqSeqNum
            
        Set RSDeclineReason = adoComm.Execute
        nNumDeclRecords = RSDeclineReason.RecordCount
        
        strDeclineReason = RSDeclineReason.Fields("decline_reason_text").Value
        
        'Validate recordset exists
        Dim blDeclineReasonsRSEmpty As Boolean
        blDeclineReasonsRSEmpty = dllRecordsetExist.IsEmpty(RSDeclineReason)
        '-------------------------------------------------------------------------------------------------------
        'Get Form Type
        If blRequestRSEmpty = True Then
                GetDeclineReasons = False
                Exit Function
        Else
            'Do While Not RSReqData.EOF
            sFormType = RSReqData.Fields("scod_form_type").Value
            'RSReqData.MoveNext
            'Loop
        End If
        '-------------------------------------------------------------------------------------------------------
        'Get SARS Application ID and Directive Type
        If blResponseRSEmpty = True Then
                GetDeclineReasons = False
                Exit Function
        Else
        
            nReqSeqNum = RSDirResData.Fields("req_seq_num").Value
            nApplID = RSDirResData.Fields("sars_appl_id").Value
            sDirType = IIf(IsNull(RSDirResData.Fields("scod_dir_type").Value), "", RSDirResData.Fields("scod_dir_type").Value)
                
            'Write XML File
            Dim dllCreateXMLDecline As clsCreateXMLDecline
            Set dllCreateXMLDecline = New clsCreateXMLDecline
            Dim blCreateXMLRes As Boolean
            
            'Delete existing xml file from folder if it still exists
            'barb: folder doesn't exist on other pcs
            'Kill ("C:\Shane\Projects\LCB\FormB\XML Docs\Response\FormB_Decline_Response.xml")
            
            'Compile Header and body of new xml file
            'strXmlVersDtdHeader = dllCreateXMLDecline.CreateXmlVersionDtdHeader()
            blCreateXMLRes = dllCreateXMLDecline.XMLCreateDeclineReason(RSDeclineReason, strDeclineXml)
        
            If blCreateXMLRes = True Then
                'RSDirResData.MoveNext
            Else
                GetDeclineReasons = False
                Exit Function
            End If
            
        End If
        '-------------------------------------------------------------------------------------------------------
        'barb: only need to do this once
        ''Get decline reason code and description
        'If blDeclineReasonsRSEmpty = True Then
        '        GetDeclineReasons = False
        '        Exit Function
        'Else
        '
        '    Do While Not RSDeclineReason.EOF
        '
        '    nCode = RSDeclineReason.Fields("decline_reason_code").Value
        '    sReasonText = RSDeclineReason.Fields("decline_reason_text").Value
        '
        '    'Write XML File
        '    blCreateXMLRes = dllCreateXMLDecline.XMLCreateDeclineReason()
        '
        '    If blCreateXMLRes = True Then
        '        RSDeclineReason.MoveNext
        '    Else
        '        GetDeclineReasons = False
        '        Exit Function
        '    End If
        '
        '    Loop
        '
        'End If
        '-------------------------------------------------------------------------------------------------------
        
        'Update Index table / Update XML table
        Dim dllSendIntIndex As clsSendIntIndex
        Set dllSendIntIndex = New clsSendIntIndex
        
        'barb:
        'Get xml file from folder where it was saved temp while building file
        'Dim xmldoc As MSXML2.DOMDocument
        'Set xmldoc = New MSXML2.DOMDocument
        'xmldoc.Load ("C:\Shane\Projects\LCB\FormB\XML Docs\Response\FormB_Decline_Response.xml")
        'strXMLResponseDecline = CStr(xmldoc.xml)
        strXMLResponseDecline = CStr(strDeclineXml)
        
        If strXMLResponseDecline <> "" Then
            If dllSendIntIndex.InsertIntoInterfaceIndex(lngNewInterfaceNo, nNewMessageID) Then
                If dllSendIntIndex.InsertIntoInterfaceXml(lngNewInterfaceNo, nNewMessageID, strXmlVersDtdHeader, strXMLResponseDecline) Then
                    If dllSendIntIndex.UpdateInterfaceIndex(nReqSeqNum) Then
                        GetDeclineReasons = True
                    Else
                        strFailReason = "InsertIntoInterfaceXml failed"
                        GetDeclineReasons = False
                    End If
                Else
                    strFailReason = "InsertIntoInterfaceXml failed"
                    GetDeclineReasons = False
                    Exit Function
                End If
            Else
                strFailReason = "InsertIntoInterfaceIndex failed"
                GetDeclineReasons = False
            End If
        Else
            GetDeclineReasons = False
            Exit Function
        End If
        
    
    
        '-------------------------------------------------------------------------------------------------------
        'clean up
        'Delete existing xml file from folder
        'barb
        'Kill ("C:\Shane\Projects\LCB\FormB\XML Docs\Response\FormB_Decline_Response.xml")
        RSReqData.Close
        Set RSReqData = Nothing
        RSDeclineReason.Close
        Set RSDeclineReason = Nothing
        Set dllCreateXMLDecline = Nothing
        Set dllSendIntIndex = Nothing
        
        'Display Progress
        iCounter = iCounter + 1
        Form1.List1.AddItem CStr(iCounter) & " - " & "Extracting decline responses - seq number: " & nReqSeqNum & " Decline Reason: " & strDeclineReason
        Form1.List1.ListIndex = iCounter - 1
        Form1.List1.Refresh
        
        RSDirResData.MoveNext
    Loop
    
End If
    

'Clean up
RSDirResData.Close
Set RSDirResData = Nothing
adoConn.Close
Set adoConn = Nothing
Set objStrConn = Nothing
Set adoComm = Nothing
Set dllCreateXMLDecline = Nothing
Set dllRecordsetExist = Nothing
Set dllSendIntIndex = Nothing
Form1.Hide

GetDeclineReasons = True
    
PROC_EXIT:
  Exit Function

PROC_ERROR:
GetDeclineReasons = False
  Err.Raise Err.Number, _
            "clsGetdeclineReasons/GetDeclineReasons", _
            Err.Description
            
Resume PROC_EXIT


End Function 'GetDeclineReasons()

